home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyProcesses.p < prev    next >
Encoding:
Text File  |  1994-09-23  |  7.2 KB  |  236 lines  |  [TEXT/PJMM]
  1. unit MyProcesses;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Processes;
  7.  
  8.     const
  9.         application = 'APPL';
  10.  
  11.     function FindApplication (creator: OSType; var fs: FSSpec): OSErr;
  12.     function FindProcess (creator, typ: OSType; var process: ProcessSerialNumber; var fs: FSSpec): boolean;
  13.     procedure LaunchWithDocument (creator, typ: OSType; fs: FSSpec; tofront: boolean);
  14.     procedure LaunchApp (creator, typ: OSType; tofront: boolean);
  15.     procedure QuitApplication (creator, typ: OSType);
  16.     procedure LaunchFSSpec (var fs: FSSpec; tofront: boolean);
  17.  
  18. implementation
  19.  
  20.     uses
  21.         AppleEvents, Aliases, MySystemGlobals, MyUtils;
  22.  
  23.     function FindApplication (creator: OSType; var fs: FSSpec): OSErr;
  24.         var
  25.             i: integer;
  26.             pbdt: DTPBRec;
  27.             crdate: longInt;
  28.             oe: OSErr;
  29.             found: boolean;
  30.     begin
  31.         found := false;
  32.         if system7 then begin
  33.             i := 1;
  34.             repeat
  35.                 fs.vRefNum := 0;
  36.                 oe := GetVolInfo(fs.name, fs.vRefNum, i, crdate);
  37.                 i := i + 1;
  38.                 if oe = noErr then begin
  39.                     with pbdt do begin
  40.                         fs.name := '';
  41.                         ioNamePtr := @fs.name;
  42.                         ioVRefNum := fs.vRefNum;
  43.                         oe := PBDTGetPath(@pbdt);
  44.                         if oe = noErr then begin
  45.                             ioIndex := 0;
  46.                             ioFileCreator := creator;
  47.                             oe := PBDTGetAPPLSync(@pbdt);
  48.                             if oe = noErr then
  49.                                 found := true;
  50.                         end;
  51.                     end;
  52.                     oe := noErr;
  53.                 end;
  54.             until found or (oe <> noErr);
  55.         end;
  56.         if found then begin
  57.             oe := noErr;
  58.             fs.parID := pbdt.ioAPPLParID;
  59.         end
  60.         else begin
  61.             oe := afpItemNotFound;
  62.             fs.vRefNum := 0;
  63.             fs.parID := 2;
  64.             fs.name := '';
  65.         end;
  66.         FindApplication := oe;
  67.     end;
  68.  
  69.     function FindProcess (creator, typ: OSType; var process: ProcessSerialNumber; var fs: FSSpec): boolean;
  70.         var
  71.             info: ProcessInfoRec;
  72.             oe: OSErr;
  73.             gv: longInt;
  74.     begin
  75.         FindProcess := false;
  76.         if (Gestalt(gestaltOSAttr, gv) = noErr) & (BTST(gv, gestaltLaunchControl)) then begin
  77.             process.highLongOfPSN := 0;
  78.             process.lowLongOfPSN := kNoProcess;
  79.             info.processInfoLength := sizeof(ProcessInfoRec);
  80.             info.processName := nil;
  81.             info.processAppSpec := @fs;
  82.             while GetNextProcess(process) = noErr do begin
  83.                 if GetProcessInformation(process, info) = noErr then begin
  84.                     if (info.processType = longInt(typ)) and (info.processSignature = creator) then begin
  85.                         FindProcess := true;
  86.                         leave;
  87.                     end;
  88.                 end;
  89.             end;
  90.         end;
  91.     end;
  92.  
  93.     procedure AddFSSToAEList (var list: AEDescList; row: integer; var fs: FSSpec);
  94.         var
  95.             fileAlias: AliasHandle;
  96.             err: OSErr;
  97.     begin
  98.         err := NewAlias(nil, fs, fileAlias);
  99.         if err = noErr then begin
  100.             HLock(handle(fileAlias));
  101.             err := AEPutPtr(list, row, typeAlias, ptr(fileAlias^), fileAlias^^.aliasSize);
  102.             DisposHandle(handle(fileAlias));
  103.         end;
  104.     end;
  105.  
  106.     procedure PrepareToLaunch (var theEvent: AppleEvent; tofront: boolean; var launchDesc: AEDesc; var launchThis: LaunchParamBlockRec);
  107.         var
  108.             oe: OSErr;
  109.     begin
  110.         oe := AECoerceDesc(theEvent, typeAppParameters, launchDesc);
  111.         HLock(handle(theEvent.dataHandle));
  112.         launchThis.launchAppParameters := AppParametersPtr(launchDesc.dataHandle^);
  113.         launchThis.launchBlockID := extendedBlock;
  114.         launchThis.launchEPBLength := extendedBlockLen;
  115.         launchThis.launchFileFlags := 0;
  116.         launchThis.launchControlFlags := launchContinue + launchNoFileFlags;
  117.         if not tofront then
  118.             launchThis.launchControlFlags := launchThis.launchControlFlags + launchDontSwitch;
  119.     end;
  120.  
  121.     procedure LaunchWithDocument (creator, typ: OSType; fs: FSSpec; tofront: boolean);
  122.         var
  123.             psn: ProcessSerialNumber;
  124.             targetAddress: AEDesc;
  125.             theEvent, theReply: AppleEvent;
  126.             fileList: AEDescList;
  127.             launchDesc: AEDesc;
  128.             app_fs: FSSpec;
  129.             launchThis: LaunchParamBlockRec;
  130.             oe: OSErr;
  131.             gv: longInt;
  132.             sendmode: AESendMode;
  133.             t, c: longInt;
  134.     begin
  135.         PurgeSpace(t, c);
  136.         if (Gestalt(gestaltOSAttr, gv) = noErr) & (BTST(gv, gestaltLaunchControl)) & (c > 4096) then begin
  137.             if FindProcess(creator, typ, psn, app_fs) then begin
  138.                 oe := AECreateDesc(typeProcessSerialNumber, @psn, sizeof(psn), targetAddress);
  139.                 oe := AECreateAppleEvent(kCoreEventClass, kAEOpenDocuments, targetAddress, kAutoGenerateReturnID, kAnyTransactionID, theEvent);
  140.                 oe := AEDisposeDesc(targetAddress);
  141.                 oe := AECreateList(nil, 0, false, fileList);
  142.                 AddFSSToAEList(fileList, 1, fs);
  143.                 oe := AEPutParamDesc(theEvent, keyDirectObject, fileList);
  144.                 sendmode := kAENoReply;
  145.                 if not tofront then
  146.                     sendmode := sendmode + kAENeverInteract;
  147.                 oe := AESend(theEvent, theReply, sendmode, kAEHighPriority, kNoTimeOut, nil, nil);
  148.                 oe := AEDisposeDesc(theEvent);
  149.                 oe := AEDisposeDesc(theReply);
  150.                 oe := AEDisposeDesc(fileList);
  151.                 if tofront then
  152.                     oe := SetFrontProcess(psn);
  153.             end
  154.             else begin
  155.                 if FindApplication(creator, app_fs) = noErr then begin
  156.                     oe := AECreateDesc(typeApplSignature, @creator, sizeof(creator), targetAddress);
  157.                     oe := AECreateAppleEvent(kCoreEventClass, kAEOpenDocuments, targetAddress, kAutoGenerateReturnID, kAnyTransactionID, theEvent);
  158.                     oe := AEDisposeDesc(targetAddress);
  159.                     oe := AECreateList(nil, 0, false, fileList);
  160.                     AddFSSToAEList(fileList, 1, fs);
  161.                     oe := AEPutParamDesc(theEvent, keyDirectObject, fileList);
  162.                     launchThis.launchAppSpec := @app_fs;
  163.                     PrepareToLaunch(theEvent, tofront, launchDesc, launchThis);
  164.                     oe := LaunchApplication(@launchThis);
  165.                     oe := AEDisposeDesc(theEvent);
  166.                     oe := AEDisposeDesc(fileList);
  167.                 end;
  168.             end;
  169.         end;
  170.     end;
  171.  
  172.     procedure LaunchFSSpec (var fs: FSSpec; tofront: boolean);
  173.         var
  174.             oe: OSErr;
  175.             fi: FInfo;
  176.             targetAddress: AEDesc;
  177.             theEvent: AppleEvent;
  178.             gv: longInt;
  179.             launchThis: LaunchParamBlockRec;
  180.             launchDesc: AEDesc;
  181.     begin
  182.         if (Gestalt(gestaltOSAttr, gv) = noErr) & (BTST(gv, gestaltLaunchControl)) then begin
  183.             oe := FSpGetFInfo(fs, fi);
  184.             oe := AECreateDesc(typeApplSignature, @fi.fdCreator, sizeof(fi.fdCreator), targetAddress);
  185.             oe := AECreateAppleEvent(kCoreEventClass, kAEOpenApplication, targetAddress, kAutoGenerateReturnID, kAnyTransactionID, theEvent);
  186.             oe := AEDisposeDesc(targetAddress);
  187.             launchThis.launchAppSpec := @fs;
  188.             PrepareToLaunch(theEvent, tofront, launchDesc, launchThis);
  189.             oe := LaunchApplication(@launchThis);
  190.             oe := AEDisposeDesc(theEvent);
  191.         end;
  192.     end;
  193.  
  194.     procedure LaunchApp (creator, typ: OSType; tofront: boolean);
  195.         var
  196.             psn: ProcessSerialNumber;
  197.             fileList: AEDescList;
  198.             app_fs: FSSpec;
  199.             oe: OSErr;
  200.             gv: longInt;
  201.             sendmode: AESendMode;
  202.     begin
  203.         if (Gestalt(gestaltOSAttr, gv) = noErr) & (BTST(gv, gestaltLaunchControl)) then begin
  204.             if FindProcess(creator, typ, psn, app_fs) then begin
  205.                 if tofront then begin
  206.                     oe := SetFrontProcess(psn);
  207.                 end;
  208.             end
  209.             else begin
  210.                 if FindApplication(creator, app_fs) = noErr then begin
  211.                     LaunchFSSpec(app_fs, tofront);
  212.                 end;
  213.             end;
  214.         end;
  215.     end;
  216.  
  217.     procedure QuitApplication (creator, typ: OSType);
  218.         var
  219.             process: processSerialNumber;
  220.             infoRec: processInfoRec;
  221.             targetAddress: AEAddressDesc;
  222.             AEvent, AReply: AppleEvent;
  223.             fs: FSSpec;
  224.             oe: OSErr;
  225.     begin
  226.         if FindProcess(creator, typ, process, fs) then begin
  227.             oe := AECreateDesc(typeProcessSerialNumber, @process, SizeOf(process), targetAddress);
  228.             oe := AECreateAppleEvent(kCoreEventClass, kAEQuitApplication, targetAddress, kAutoGenerateReturnID, kAnyTransactionID, AEvent);
  229.             oe := AEDisposeDesc(targetAddress);
  230.             oe := AESend(AEvent, AReply, kAENoReply, kAEHighPriority, 5 * 60, nil, nil);
  231.             oe := AEDisposeDesc(AEvent);
  232.             oe := AEDisposeDesc(AReply);
  233.         end;
  234.     end;
  235.  
  236. end.